Required R packages

The diprate package is available from GitHub here: dipDRC

library(diprate)

Static data

static <- read.csv("../data/from_CW_via_Slack_20210507/StaticDF.csv", row.names=1)
static <- static[order(static$Culture_Type,static$Cell_Line),]
static[static$Cell_Conc==0,"Cell_Conc"] <- 1
cell_lines <- unique(static$Cell_Line)

Outlier value in CORL279

static <- static[!(static$Cell_Line=="CORL279" & static$RLU < 10),]

Code for reproducing figures

Correlation between luminescence and cell count

par(mfrow=c(2,5))
linear_models <- lapply(cell_lines, function(cl) {
        dat <- static[static$Cell_Line==cl,]
        culture_type <- unique(dat$Culture_Type)
        m <- lm(log2(RLU) ~ log2(Cell_Conc), data = dat)
        plot(log2(RLU) ~ log2(Cell_Conc), data=dat, main=paste0(cl," (",culture_type,")"), xlim=c(0,14), ylim=c(7,18))
        abline(m, col="blue")
        return(m)
    })

names(linear_models) <- cell_lines

Need 2-part function to accommodate minimum values

Assuming first part of data is at some minimum value and not associated with any actual cell count (lower limit of detection), which would result in slope=0 (values are constant until some minimum number of cells is achieved).

lagLine <- function (x, lower, slope, br = 64) sapply(x, function(z) ifelse(z <= br, lower, lower + (z-br) * slope))

fitLagLin <- function(x, y, start_list=list(lower=5, slope=1, br=1)) 
    nls(y ~ lagLine(x=x, lower, slope, br),
        start = start_list,
        algorithm="port",
        control=nls.control(maxiter=500)
        )

Fit the lag-linear model to data

par(mfrow=c(2,5))
lag_linear_models <- lapply(cell_lines, function(cl) {
    m <- tryCatch({
        dat <- static[static$Cell_Line==cl,]
        culture_type <- unique(dat$Culture_Type)
        m <- fitLagLin(log2(dat$Cell_Conc), log2(dat$RLU))
    }, error=function(e) { return(e) })
    # if(culture_type == "Adherent") 
    # {
    #     xr <- c(4,12)
    # } else {
    #     xr <- c(6,14)
    # }
    xr <- c(0,14)
    plot(log2(RLU) ~ log2(Cell_Conc), data=dat, main=paste0(cl," (",culture_type,")"), xlim=xr, ylim=c(7,18))
    if(class(m)[1] != "nls")
    {
        m <- lm(log2(RLU) ~ log2(Cell_Conc), data=dat[dat$Cell_Conc>1,])
        abline(m, col="blue", lwd=2)
    } else {
        curve(from=0.5,to=18, lagLine(x, lower=coef(m)['lower'], 
                                      slope=coef(m)['slope'], 
                                      br=coef(m)['br']), 
              col="blue", lwd=2, add=TRUE)
    }
    # text(12, 9, paste("Adj R2 ="))
    return(m)
})

names(lag_linear_models) <- cell_lines

Try eliminating controls

Assume all luminescence values with cells produce detectable signal.

par(mfrow=c(2,5))
linear_models <- lapply(cell_lines, function(cl) {
        dat <- static[static$Cell_Line==cl & static$Cell_Conc >1,]
        culture_type <- unique(dat$Culture_Type)
        m <- lm(log2(RLU) ~ log2(Cell_Conc), data = dat)
        plot(log2(RLU) ~ log2(Cell_Conc), data=dat, main=paste0(cl," (",culture_type,")"), xlim=c(0,14), ylim=c(7,18))
        abline(m, col="blue")
        return(m)
    })

names(linear_models) <- cell_lines

Compare to linear models

Assuming the lowest number of cells is above the threshold of detection, will remove the no cells control and fit remaining data.

dat <- static[static$Cell_Conc > 1,]
m2 <- lme4::lmList(log2(RLU) ~ log2(Cell_Conc) | Cell_Line, data=dat)
f2 <- coef(m2)
r2 <- unlist(summary(m2)$adj.r.squared)
par(mfrow=c(2,5))
temp <- lapply(cell_lines, function(cl) {
    dtp <- dat[dat$Cell_Line==cl,]
    culture_type <- unique(dtp[dtp$Cell_Line==cl,'Culture_Type'])
    if(culture_type == "Adherent") 
    {
        xr <- c(5,12)
    } else {
        xr <- c(7,14)
    }
    plot(log2(RLU) ~ log2(Cell_Conc), 
         data=dtp, 
         main=paste0(cl," (",culture_type,")"), 
         xlim=xr, ylim=c(7,18))
    abline(m2[[cl]], col="blue", lwd=2)
    text(xr[1]+0.25, 17, pos=4, paste("slope =",signif(f2[cl,2],3)))
    text(xr[1]+0.25, 16, pos=4, expression(R^2))
    text(xr[1]+1, 16, pos=4, paste("=", signif(r2[cl],3)))
})

fitLagLin1 <- function(x, y, start_list=list(lower=5, br=1)) 
    nls(y ~ lagLine(x=x, lower, slope=1, br),
        start = start_list,
        algorithm="port",
        control=nls.control(maxiter=500)
        )

par(mfrow=c(2,5))
lag_linear1_models <- lapply(cell_lines, function(cl) {
    m <- tryCatch({
        dat <- static[static$Cell_Line==cl,]
        culture_type <- unique(dat$Culture_Type)
        m <- fitLagLin1(log2(dat$Cell_Conc), log2(dat$RLU))
    }, error=function(e) { return(e) })
    # if(culture_type == "Adherent") 
    # {
    #     xr <- c(4,12)
    # } else {
    #     xr <- c(6,14)
    # }
    xr <- c(0,14)
    plot(log2(RLU) ~ log2(Cell_Conc), data=dat, main=paste0(cl," (",culture_type,")"), xlim=xr, ylim=c(7,18))
    if(class(m)[1] != "nls")
    {
        m <- lm(log2(RLU) ~ log2(Cell_Conc), data=dat[dat$Cell_Conc>1,])
        abline(m, col="blue", lwd=2)
    } else {
        curve(from=0.5,to=18, lagLine(x, lower=coef(m)['lower'], 
                                      slope=1, 
                                      br=coef(m)['br']), 
              col="blue", lwd=2, add=TRUE)
    }
    # text(12, 9, paste("Adj R2 ="))
    return(m)
})

names(lag_linear1_models) <- cell_lines

Combined cell count & lum data

lcc_cell_lines <- unique(lcc$cell.line)
ctrls <- lapply(lcc_cell_lines, function(cl) lcc[lcc$cell.line==cl & lcc$drug1.conc==0,])
names(ctrls) <- lcc_cell_lines

Cell counts

par(mfrow=c(2,2))
invisible(lapply(names(ctrls), function(n) do.call(plotGC, 
        append(getGCargs(ctrls[[n]], dat.col=c("time","Cell_Count","uid")),list(main=n, leg=FALSE)))))

Luminscence

par(mfrow=c(2,2))
invisible(lapply(names(ctrls), function(n) do.call(plotGC, 
        append(getGCargs(ctrls[[n]], dat.col=c("time","RLU","uid")),list(main=n)))))

dms53 <- ctrls[['DMS53']]

par(mfrow=c(1,2))

invisible(do.call(plotGC, append(getGCargs(dms53),list(main="DMS53, cell count", leg=FALSE))))
invisible(do.call(plotGC, append(getGCargs(dms53, dat.col=c("time","RLU","uid")),list(main="DMS53, lum", leg=FALSE))))

h1048 <- ctrls[['H1048']]

par(mfrow=c(1,2))

invisible(do.call(plotGC, append(getGCargs(h1048, dat.col=c("time","Cell_Count","uid")),list(main="H1048, cell count", leg=FALSE))))
invisible(do.call(plotGC, append(getGCargs(h1048, dat.col=c("time","RLU","uid")),list(main="H1048, lum", leg=FALSE))))

Sum of all control cell counts at each time point

invisible(do.call(plotGC, append(getGCargs(h1048, dat.col=c("time","RLU","uid")),list(main="H1048, lum", leg=FALSE))))
lines(log2(cell.count)-log2(cell.count)[1] ~ time, data=h1048_sumc, lwd=3)

LS0tCnRpdGxlOiAiUmVhbC10aW1lIGx1bWluZXNjZW5jZSBlbmFibGVzIGVzdGltYXRpb24gb2YgZHJ1Zy1pbmR1Y2VkIHByb2xpZmVyYXRpb24gcmF0ZXMgaW4gYWRoZXJlbnQgYW5kIHN1c3BlbnNpb24gY2VsbCBsaW5lcyIKYXV0aG9yOiAiRGFycmVuIFR5c29uICYgQ2xheXRvbiBXYW5kaXNoaW4iCmRhdGU6ICIwNS8wOS8yMDIxIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgojIyBSZXF1aXJlZCBSIHBhY2thZ2VzClRoZSBgZGlwcmF0ZWAgcGFja2FnZSBpcyBhdmFpbGFibGUgZnJvbSBHaXRIdWIgaGVyZTogW2RpcERSQ10oaHR0cHM6Ly93d3cuZ2l0aHViLmNvbS9RdWxhYi1WVS9kaXBEUkMpCmBgYHtyIFNldHVwfQpsaWJyYXJ5KGRpcHJhdGUpCmBgYAoKIyMgU3RhdGljIGRhdGEKYGBge3IgTG9hZCBkYXRhfQpzdGF0aWMgPC0gcmVhZC5jc3YoIi4uL2RhdGEvZnJvbV9DV192aWFfU2xhY2tfMjAyMTA1MDcvU3RhdGljREYuY3N2Iiwgcm93Lm5hbWVzPTEpCnN0YXRpYyA8LSBzdGF0aWNbb3JkZXIoc3RhdGljJEN1bHR1cmVfVHlwZSxzdGF0aWMkQ2VsbF9MaW5lKSxdCnN0YXRpY1tzdGF0aWMkQ2VsbF9Db25jPT0wLCJDZWxsX0NvbmMiXSA8LSAxCmNlbGxfbGluZXMgPC0gdW5pcXVlKHN0YXRpYyRDZWxsX0xpbmUpCmBgYAojIyMjIE91dGxpZXIgdmFsdWUgaW4gQ09STDI3OQpgYGB7cn0Kc3RhdGljIDwtIHN0YXRpY1shKHN0YXRpYyRDZWxsX0xpbmU9PSJDT1JMMjc5IiAmIHN0YXRpYyRSTFUgPCAxMCksXQpgYGAKCgojIyBDb2RlIGZvciByZXByb2R1Y2luZyBmaWd1cmVzCiMjIyBDb3JyZWxhdGlvbiBiZXR3ZWVuIGx1bWluZXNjZW5jZSBhbmQgY2VsbCBjb3VudApgYGB7ciBDZWxsIGNvdW50ICYgbHVtaW5lc2NlbmNlLCBmaWcuaGVpZ2h0PTMsIGZpZy53aWR0aD03fQpwYXIobWZyb3c9YygyLDUpKQpsaW5lYXJfbW9kZWxzIDwtIGxhcHBseShjZWxsX2xpbmVzLCBmdW5jdGlvbihjbCkgewogICAgICAgIGRhdCA8LSBzdGF0aWNbc3RhdGljJENlbGxfTGluZT09Y2wsXQogICAgICAgIGN1bHR1cmVfdHlwZSA8LSB1bmlxdWUoZGF0JEN1bHR1cmVfVHlwZSkKICAgICAgICBtIDwtIGxtKGxvZzIoUkxVKSB+IGxvZzIoQ2VsbF9Db25jKSwgZGF0YSA9IGRhdCkKICAgICAgICBwbG90KGxvZzIoUkxVKSB+IGxvZzIoQ2VsbF9Db25jKSwgZGF0YT1kYXQsIG1haW49cGFzdGUwKGNsLCIgKCIsY3VsdHVyZV90eXBlLCIpIiksIHhsaW09YygwLDE0KSwgeWxpbT1jKDcsMTgpKQogICAgICAgIGFibGluZShtLCBjb2w9ImJsdWUiKQogICAgICAgIHJldHVybihtKQogICAgfSkKbmFtZXMobGluZWFyX21vZGVscykgPC0gY2VsbF9saW5lcwpgYGAKCiMjIyMgTmVlZCAyLXBhcnQgZnVuY3Rpb24gdG8gYWNjb21tb2RhdGUgbWluaW11bSB2YWx1ZXMKQXNzdW1pbmcgZmlyc3QgcGFydCBvZiBkYXRhIGlzIGF0IHNvbWUgbWluaW11bSB2YWx1ZSBhbmQgbm90IGFzc29jaWF0ZWQgd2l0aCBhbnkgYWN0dWFsIGNlbGwgY291bnQgKGxvd2VyIGxpbWl0IG9mIGRldGVjdGlvbiksIHdoaWNoIHdvdWxkIHJlc3VsdCBpbiBgc2xvcGU9MGAgKHZhbHVlcyBhcmUgY29uc3RhbnQgdW50aWwgc29tZSBtaW5pbXVtIG51bWJlciBvZiBjZWxscyBpcyBhY2hpZXZlZCkuCmBgYHtyIExhZy1saW5lYXIgZnVuY3Rpb259CmxhZ0xpbmUgPC0gZnVuY3Rpb24gKHgsIGxvd2VyLCBzbG9wZSwgYnIgPSA2NCkgc2FwcGx5KHgsIGZ1bmN0aW9uKHopIGlmZWxzZSh6IDw9IGJyLCBsb3dlciwgbG93ZXIgKyAoei1icikgKiBzbG9wZSkpCgpmaXRMYWdMaW4gPC0gZnVuY3Rpb24oeCwgeSwgc3RhcnRfbGlzdD1saXN0KGxvd2VyPTUsIHNsb3BlPTEsIGJyPTEpKSAKICAgIG5scyh5IH4gbGFnTGluZSh4PXgsIGxvd2VyLCBzbG9wZSwgYnIpLAogICAgICAgIHN0YXJ0ID0gc3RhcnRfbGlzdCwKICAgICAgICBhbGdvcml0aG09InBvcnQiLAogICAgICAgIGNvbnRyb2w9bmxzLmNvbnRyb2wobWF4aXRlcj01MDApCiAgICAgICAgKQpgYGAKCiMjIyMgRml0IHRoZSBsYWctbGluZWFyIG1vZGVsIHRvIGRhdGEKYGBge3IgTGFnLWxpbmVhciBtb2RlbCBmaXRzLCBmaWcuaGVpZ2h0PTMsIGZpZy53aWR0aD03fQpwYXIobWZyb3c9YygyLDUpKQpsYWdfbGluZWFyX21vZGVscyA8LSBsYXBwbHkoY2VsbF9saW5lcywgZnVuY3Rpb24oY2wpIHsKICAgIG0gPC0gdHJ5Q2F0Y2goewogICAgICAgIGRhdCA8LSBzdGF0aWNbc3RhdGljJENlbGxfTGluZT09Y2wsXQogICAgICAgIGN1bHR1cmVfdHlwZSA8LSB1bmlxdWUoZGF0JEN1bHR1cmVfVHlwZSkKICAgICAgICBtIDwtIGZpdExhZ0xpbihsb2cyKGRhdCRDZWxsX0NvbmMpLCBsb2cyKGRhdCRSTFUpKQogICAgfSwgZXJyb3I9ZnVuY3Rpb24oZSkgeyByZXR1cm4oZSkgfSkKICAgICMgaWYoY3VsdHVyZV90eXBlID09ICJBZGhlcmVudCIpIAogICAgIyB7CiAgICAjICAgICB4ciA8LSBjKDQsMTIpCiAgICAjIH0gZWxzZSB7CiAgICAjICAgICB4ciA8LSBjKDYsMTQpCiAgICAjIH0KICAgIHhyIDwtIGMoMCwxNCkKICAgIHBsb3QobG9nMihSTFUpIH4gbG9nMihDZWxsX0NvbmMpLCBkYXRhPWRhdCwgbWFpbj1wYXN0ZTAoY2wsIiAoIixjdWx0dXJlX3R5cGUsIikiKSwgeGxpbT14ciwgeWxpbT1jKDcsMTgpKQogICAgaWYoY2xhc3MobSlbMV0gIT0gIm5scyIpCiAgICB7CiAgICAgICAgbSA8LSBsbShsb2cyKFJMVSkgfiBsb2cyKENlbGxfQ29uYyksIGRhdGE9ZGF0W2RhdCRDZWxsX0NvbmM+MSxdKQogICAgICAgIGFibGluZShtLCBjb2w9ImJsdWUiLCBsd2Q9MikKICAgIH0gZWxzZSB7CiAgICAgICAgY3VydmUoZnJvbT0wLjUsdG89MTgsIGxhZ0xpbmUoeCwgbG93ZXI9Y29lZihtKVsnbG93ZXInXSwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2xvcGU9Y29lZihtKVsnc2xvcGUnXSwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYnI9Y29lZihtKVsnYnInXSksIAogICAgICAgICAgICAgIGNvbD0iYmx1ZSIsIGx3ZD0yLCBhZGQ9VFJVRSkKICAgIH0KICAgICMgdGV4dCgxMiwgOSwgcGFzdGUoIkFkaiBSMiA9IikpCiAgICByZXR1cm4obSkKfSkKbmFtZXMobGFnX2xpbmVhcl9tb2RlbHMpIDwtIGNlbGxfbGluZXMKYGBgCgoKIyMjIyBUcnkgZWxpbWluYXRpbmcgY29udHJvbHMKQXNzdW1lIGFsbCBsdW1pbmVzY2VuY2UgdmFsdWVzIHdpdGggY2VsbHMgcHJvZHVjZSBkZXRlY3RhYmxlIHNpZ25hbC4KYGBge3IgQ2VsbCBjb3VudCAmIGx1bWluZXNjZW5jZSBtaW51cyBjb250cm9sLCBmaWcuaGVpZ2h0PTMsIGZpZy53aWR0aD03fQpwYXIobWZyb3c9YygyLDUpKQpsaW5lYXJfbW9kZWxzIDwtIGxhcHBseShjZWxsX2xpbmVzLCBmdW5jdGlvbihjbCkgewogICAgICAgIGRhdCA8LSBzdGF0aWNbc3RhdGljJENlbGxfTGluZT09Y2wgJiBzdGF0aWMkQ2VsbF9Db25jID4xLF0KICAgICAgICBjdWx0dXJlX3R5cGUgPC0gdW5pcXVlKGRhdCRDdWx0dXJlX1R5cGUpCiAgICAgICAgbSA8LSBsbShsb2cyKFJMVSkgfiBsb2cyKENlbGxfQ29uYyksIGRhdGEgPSBkYXQpCiAgICAgICAgcGxvdChsb2cyKFJMVSkgfiBsb2cyKENlbGxfQ29uYyksIGRhdGE9ZGF0LCBtYWluPXBhc3RlMChjbCwiICgiLGN1bHR1cmVfdHlwZSwiKSIpLCB4bGltPWMoMCwxNCksIHlsaW09Yyg3LDE4KSkKICAgICAgICBhYmxpbmUobSwgY29sPSJibHVlIikKICAgICAgICByZXR1cm4obSkKICAgIH0pCm5hbWVzKGxpbmVhcl9tb2RlbHMpIDwtIGNlbGxfbGluZXMKYGBgCgoKCiMjIyMgQ29tcGFyZSB0byBsaW5lYXIgbW9kZWxzCkFzc3VtaW5nIHRoZSBsb3dlc3QgbnVtYmVyIG9mIGNlbGxzIGlzIGFib3ZlIHRoZSB0aHJlc2hvbGQgb2YgZGV0ZWN0aW9uLCB3aWxsIHJlbW92ZSB0aGUgbm8gY2VsbHMgY29udHJvbCBhbmQgZml0IHJlbWFpbmluZyBkYXRhLgpgYGB7cn0KZGF0IDwtIHN0YXRpY1tzdGF0aWMkQ2VsbF9Db25jID4gMSxdCm0yIDwtIGxtZTQ6OmxtTGlzdChsb2cyKFJMVSkgfiBsb2cyKENlbGxfQ29uYykgfCBDZWxsX0xpbmUsIGRhdGE9ZGF0KQpmMiA8LSBjb2VmKG0yKQpyMiA8LSB1bmxpc3Qoc3VtbWFyeShtMikkYWRqLnIuc3F1YXJlZCkKYGBgCgpgYGB7ciBMaW5lYXIgbW9kZWxzLCBmaWcuaGVpZ2h0PTMsIGZpZy53aWR0aD03fQpwYXIobWZyb3c9YygyLDUpKQp0ZW1wIDwtIGxhcHBseShjZWxsX2xpbmVzLCBmdW5jdGlvbihjbCkgewogICAgZHRwIDwtIGRhdFtkYXQkQ2VsbF9MaW5lPT1jbCxdCiAgICBjdWx0dXJlX3R5cGUgPC0gdW5pcXVlKGR0cFtkdHAkQ2VsbF9MaW5lPT1jbCwnQ3VsdHVyZV9UeXBlJ10pCiAgICBpZihjdWx0dXJlX3R5cGUgPT0gIkFkaGVyZW50IikgCiAgICB7CiAgICAgICAgeHIgPC0gYyg1LDEyKQogICAgfSBlbHNlIHsKICAgICAgICB4ciA8LSBjKDcsMTQpCiAgICB9CiAgICBwbG90KGxvZzIoUkxVKSB+IGxvZzIoQ2VsbF9Db25jKSwgCiAgICAgICAgIGRhdGE9ZHRwLCAKICAgICAgICAgbWFpbj1wYXN0ZTAoY2wsIiAoIixjdWx0dXJlX3R5cGUsIikiKSwgCiAgICAgICAgIHhsaW09eHIsIHlsaW09Yyg3LDE4KSkKICAgIGFibGluZShtMltbY2xdXSwgY29sPSJibHVlIiwgbHdkPTIpCiAgICB0ZXh0KHhyWzFdKzAuMjUsIDE3LCBwb3M9NCwgcGFzdGUoInNsb3BlID0iLHNpZ25pZihmMltjbCwyXSwzKSkpCiAgICB0ZXh0KHhyWzFdKzAuMjUsIDE2LCBwb3M9NCwgZXhwcmVzc2lvbihSXjIpKQogICAgdGV4dCh4clsxXSsxLCAxNiwgcG9zPTQsIHBhc3RlKCI9Iiwgc2lnbmlmKHIyW2NsXSwzKSkpCn0pCgpgYGAKCmBgYHtyIExhZy1saW5lYXIgc2xvcGUgZXEgMSBtb2RlbCBmaXRzLCBmaWcuaGVpZ2h0PTMsIGZpZy53aWR0aD03fQpmaXRMYWdMaW4xIDwtIGZ1bmN0aW9uKHgsIHksIHN0YXJ0X2xpc3Q9bGlzdChsb3dlcj01LCBicj0xKSkgCiAgICBubHMoeSB+IGxhZ0xpbmUoeD14LCBsb3dlciwgc2xvcGU9MSwgYnIpLAogICAgICAgIHN0YXJ0ID0gc3RhcnRfbGlzdCwKICAgICAgICBhbGdvcml0aG09InBvcnQiLAogICAgICAgIGNvbnRyb2w9bmxzLmNvbnRyb2wobWF4aXRlcj01MDApCiAgICAgICAgKQoKcGFyKG1mcm93PWMoMiw1KSkKbGFnX2xpbmVhcjFfbW9kZWxzIDwtIGxhcHBseShjZWxsX2xpbmVzLCBmdW5jdGlvbihjbCkgewogICAgbSA8LSB0cnlDYXRjaCh7CiAgICAgICAgZGF0IDwtIHN0YXRpY1tzdGF0aWMkQ2VsbF9MaW5lPT1jbCxdCiAgICAgICAgY3VsdHVyZV90eXBlIDwtIHVuaXF1ZShkYXQkQ3VsdHVyZV9UeXBlKQogICAgICAgIG0gPC0gZml0TGFnTGluMShsb2cyKGRhdCRDZWxsX0NvbmMpLCBsb2cyKGRhdCRSTFUpKQogICAgfSwgZXJyb3I9ZnVuY3Rpb24oZSkgeyByZXR1cm4oZSkgfSkKICAgICMgaWYoY3VsdHVyZV90eXBlID09ICJBZGhlcmVudCIpIAogICAgIyB7CiAgICAjICAgICB4ciA8LSBjKDQsMTIpCiAgICAjIH0gZWxzZSB7CiAgICAjICAgICB4ciA8LSBjKDYsMTQpCiAgICAjIH0KICAgIHhyIDwtIGMoMCwxNCkKICAgIHBsb3QobG9nMihSTFUpIH4gbG9nMihDZWxsX0NvbmMpLCBkYXRhPWRhdCwgbWFpbj1wYXN0ZTAoY2wsIiAoIixjdWx0dXJlX3R5cGUsIikiKSwgeGxpbT14ciwgeWxpbT1jKDcsMTgpKQogICAgaWYoY2xhc3MobSlbMV0gIT0gIm5scyIpCiAgICB7CiAgICAgICAgbSA8LSBsbShsb2cyKFJMVSkgfiBsb2cyKENlbGxfQ29uYyksIGRhdGE9ZGF0W2RhdCRDZWxsX0NvbmM+MSxdKQogICAgICAgIGFibGluZShtLCBjb2w9ImJsdWUiLCBsd2Q9MikKICAgIH0gZWxzZSB7CiAgICAgICAgY3VydmUoZnJvbT0wLjUsdG89MTgsIGxhZ0xpbmUoeCwgbG93ZXI9Y29lZihtKVsnbG93ZXInXSwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgc2xvcGU9MSwgCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYnI9Y29lZihtKVsnYnInXSksIAogICAgICAgICAgICAgIGNvbD0iYmx1ZSIsIGx3ZD0yLCBhZGQ9VFJVRSkKICAgIH0KICAgICMgdGV4dCgxMiwgOSwgcGFzdGUoIkFkaiBSMiA9IikpCiAgICByZXR1cm4obSkKfSkKbmFtZXMobGFnX2xpbmVhcjFfbW9kZWxzKSA8LSBjZWxsX2xpbmVzCmBgYAoKCgojIyBDb21iaW5lZCBjZWxsIGNvdW50ICYgbHVtIGRhdGEKCmBgYHtyfQpsY2MgPC0gcmVhZC5jc3YoJy4uL2RhdGEvZnJvbV9DV192aWFfU2xhY2tfMjAyMTA1MDcvMjAyMDEyMTZfTHVtX0NlbGxDb3VudHNfVGh1bm9yLmNzdicsIHJvdy5uYW1lcz0xKQpsY2MgPC0gbGNjWywtMV0KbGNjJHVpZCA8LSBwYXN0ZShsY2MkdXBpZCxsY2Mkd2VsbCxzZXA9Il8iKQpsY2MgPC0gbGNjW29yZGVyKGxjYyR1aWQsbGNjJHRpbWUpLF0KbGNjIDwtIGxjY1tsY2MkdGltZSA8PSA5NixdCmBgYAoKCmBgYHtyfQpsY2NfY2VsbF9saW5lcyA8LSB1bmlxdWUobGNjJGNlbGwubGluZSkKY3RybHMgPC0gbGFwcGx5KGxjY19jZWxsX2xpbmVzLCBmdW5jdGlvbihjbCkgbGNjW2xjYyRjZWxsLmxpbmU9PWNsICYgbGNjJGRydWcxLmNvbmM9PTAsXSkKbmFtZXMoY3RybHMpIDwtIGxjY19jZWxsX2xpbmVzCmBgYAoKIyMjIyBDZWxsIGNvdW50cwpgYGB7ciBmaWcuaGVpZ2h0PTYsIGZpZy53aWR0aD02fQpwYXIobWZyb3c9YygyLDIpKQppbnZpc2libGUobGFwcGx5KG5hbWVzKGN0cmxzKSwgZnVuY3Rpb24obikgZG8uY2FsbChwbG90R0MsIAogICAgICAgIGFwcGVuZChnZXRHQ2FyZ3MoY3RybHNbW25dXSwgZGF0LmNvbD1jKCJ0aW1lIiwiQ2VsbF9Db3VudCIsInVpZCIpKSxsaXN0KG1haW49biwgbGVnPUZBTFNFKSkpKSkKYGBgCiMjIyMgTHVtaW5zY2VuY2UKYGBge3IgTHVtaW5lc2NlbmNlLCBmaWcuaGVpZ2h0PTYsIGZpZy53aWR0aD02fQpwYXIobWZyb3c9YygyLDIpKQppbnZpc2libGUobGFwcGx5KG5hbWVzKGN0cmxzKSwgZnVuY3Rpb24obikgZG8uY2FsbChwbG90R0MsIAogICAgICAgIGFwcGVuZChnZXRHQ2FyZ3MoY3RybHNbW25dXSwgZGF0LmNvbD1jKCJ0aW1lIiwiUkxVIiwidWlkIikpLGxpc3QobWFpbj1uLCBsZWc9RkFMU0UpKSkpKQpgYGAKCmBgYHtyIERNUzUzLCBmaWcuaGVpZ2h0PTMsIGZpZy53aWR0aD02fQpkbXM1MyA8LSBjdHJsc1tbJ0RNUzUzJ11dCgpwYXIobWZyb3c9YygxLDIpKQoKaW52aXNpYmxlKGRvLmNhbGwocGxvdEdDLCBhcHBlbmQoZ2V0R0NhcmdzKGRtczUzKSxsaXN0KG1haW49IkRNUzUzLCBjZWxsIGNvdW50IiwgbGVnPUZBTFNFKSkpKQppbnZpc2libGUoZG8uY2FsbChwbG90R0MsIGFwcGVuZChnZXRHQ2FyZ3MoZG1zNTMsIGRhdC5jb2w9YygidGltZSIsIlJMVSIsInVpZCIpKSxsaXN0KG1haW49IkRNUzUzLCBsdW0iLCBsZWc9RkFMU0UpKSkpCmBgYAoKYGBge3IgSDEwNDgsIGZpZy5oZWlnaHQ9MywgZmlnLndpZHRoPTZ9CmgxMDQ4IDwtIGN0cmxzW1snSDEwNDgnXV0KCnBhcihtZnJvdz1jKDEsMikpCgppbnZpc2libGUoZG8uY2FsbChwbG90R0MsIGFwcGVuZChnZXRHQ2FyZ3MoaDEwNDgsIGRhdC5jb2w9YygidGltZSIsIkNlbGxfQ291bnQiLCJ1aWQiKSksbGlzdChtYWluPSJIMTA0OCwgY2VsbCBjb3VudCIsIGxlZz1GQUxTRSkpKSkKaW52aXNpYmxlKGRvLmNhbGwocGxvdEdDLCBhcHBlbmQoZ2V0R0NhcmdzKGgxMDQ4LCBkYXQuY29sPWMoInRpbWUiLCJSTFUiLCJ1aWQiKSksbGlzdChtYWluPSJIMTA0OCwgbHVtIiwgbGVnPUZBTFNFKSkpKQpgYGAKIyMjIyBTdW0gb2YgYWxsIGNvbnRyb2wgY2VsbCBjb3VudHMgYXQgZWFjaCB0aW1lIHBvaW50CmBgYHtyfQpoMTA0OF9zdW1jIDwtIHNhcHBseSh1bmlxdWUoaDEwNDgkdGltZSksIGZ1bmN0aW9uKGkpIHN1bShoMTA0OFtoMTA0OCR0aW1lPT1pLCJDZWxsX0NvdW50Il0pKQpoMTA0OF9zdW1jIDwtIGRhdGEuZnJhbWUodGltZT11bmlxdWUoaDEwNDgkdGltZSksIGNlbGwuY291bnQ9aDEwNDhfc3VtYykKcGxvdChsb2cyKGNlbGwuY291bnQpLWxvZzIoY2VsbC5jb3VudClbMV0gfiB0aW1lLCBkYXRhPWgxMDQ4X3N1bWMsIHR5cGU9ImwiLCB5bGFiPSJQb3B1bGF0aW9uIGRvdWJsaW5ncyIpCmBgYAoKYGBge3J9CmludmlzaWJsZShkby5jYWxsKHBsb3RHQywgYXBwZW5kKGdldEdDYXJncyhoMTA0OCwgZGF0LmNvbD1jKCJ0aW1lIiwiUkxVIiwidWlkIikpLGxpc3QobWFpbj0iSDEwNDgsIGx1bSIsIGxlZz1GQUxTRSkpKSkKbGluZXMobG9nMihjZWxsLmNvdW50KS1sb2cyKGNlbGwuY291bnQpWzFdIH4gdGltZSwgZGF0YT1oMTA0OF9zdW1jLCBsd2Q9MykKYGBgCgo=